home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / macros / mathematica / tex-mma.tar_z / tex-mma / tex-mma.el < prev    next >
Lisp/Scheme  |  1991-05-08  |  53KB  |  1,566 lines
  1. ;; File tex-mma.el
  2. ;; Major modes for interaction with Mathematica from a TeX buffer
  3. ;; Written 2/12/1991 by Dan Dill dan@chem.bu.edu
  4.  
  5. (defconst tex-mma-version-string
  6.   "TeX/Mathematica Version 1.3 <Wed 8 April 1991> Copyright 1991 Dan Dill"
  7.   "String describing this version of TeX/Mathematica.")
  8.  
  9. (defconst tex-mma-herald
  10.   "This is TeX/Mathematica 1.3 Copyright 1991 Dan Dill.  "
  11.   "Startup message.")
  12.  
  13. ;; Copyright (C) 1991 Dan Dill
  14. ;; This is part of TeX/Mathematica
  15. ;;
  16. ;; TeX/Mathematica is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility to
  18. ;; anyone for the consequences of using it or for whether it serves any
  19. ;; particular purpose or works at all, unless he says so in writing.
  20. ;;
  21. ;; Everyone is granted permission to copy, modify and redistribute this
  22. ;; tex-mma package, provided:
  23. ;;  1.  All copies contain this copyright notice.
  24. ;;  2.  All modified copies shall carry a prominant notice stating who
  25. ;;      made the last modification and the date of such modification.
  26. ;;  3.  No charge is made for this software or works derived from it.  
  27. ;;      This clause shall not be construed as constraining other software
  28. ;;      distributed on the same medium as this software, nor is a
  29. ;;      distribution fee considered a charge.
  30. ;;
  31. ;; Portions of this package were adapted from GNU Emacs.
  32. ;;
  33. ;; Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc. 
  34. ;; 
  35. ;; GNU Emacs is distributed in the hope that it will be useful,
  36. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  37. ;; accepts responsibility to anyone for the consequences of using it
  38. ;; or for whether it serves any particular purpose or works at all,
  39. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  40. ;; License for full details.
  41. ;;
  42. ;; Everyone is granted permission to copy, modify and redistribute
  43. ;; GNU Emacs, but only under the conditions described in the
  44. ;; GNU Emacs General Public License.   A copy of this license is
  45. ;; supposed to have been given to you along with GNU Emacs so you
  46. ;; can know your rights and responsibilities.  It should be in a
  47. ;; file named COPYING.  Among other things, the copyright notice
  48. ;; and this notice must be preserved on all copies.
  49.  
  50.  
  51. ;; Developed with GNU Emacs version 18.55
  52.  
  53. ;; 2/17/1991
  54. ;;   Version 1 -> 1.1:  Replace shell-mma-mode with David Jacobson's math-mode
  55.  
  56. ;; 2/20/1991
  57. ;;   Fix syntax table misassignment in tex-mma-send-cell, caught by
  58. ;;   Weiqi Gao gao@ucrmath.ucr.edu
  59.  
  60. ;; 2/21/1991
  61. ;;   Change (defconst ...) to (defvar ...) so user (setq ...) preserved,
  62. ;;   Dave Gillespie daveg@csvax.cs.caltech.edu
  63.  
  64. ;; 2/28/1991 Version 1.1 -> 1.2:
  65. ;;   TeX-Mathematica-help -> Texinfo tex-mma.info
  66. ;;   mma -> mathematica for user-visible functions
  67. ;;   Fix logic in tex-mma-eval-init so bogus cells bypassed
  68.  
  69. ;; 3/5/1991
  70. ;;   Add latex-mathematica and plain-tex-mathematica
  71.  
  72. ;; 3/6/1991
  73. ;;   Add tex-mma-eval-all-ask/noask (C-c a/C-u C-c a)
  74.  
  75. ;; 4/9/1991 Version 1.2 -> 1.3
  76. ;;   Don't start Mathematica until needed.
  77. ;;   Bind tex-mma-recenter to C-c l.
  78. ;;   Adapt/add code for generic TeX/Mathematica interface.
  79. ;;   Add tex-mma-assemble-package (C-c m) to assemble packages from cells;
  80. ;;     related changes.
  81. ;;   Renamed many functions; general cleanup
  82.  
  83. ;; 4/26/1991
  84. ;;   Rework package interface
  85. ;;   Rename tex-mma-assemble-cell to tex-mma-create-cell (C-c c)
  86. ;;   Add tex-mma-assemble-cell (C-u C-c m) to assemble a cell
  87. ;;   tex-mma-eval-all/init bypass cells containing cell references
  88.  
  89. ;; 5/8/1991
  90. ;;   Change tex-mma-math-send-cell to use double unwind-protect, to work
  91. ;;   with revised math.el.
  92. ;;   Make tex-mma-new-types user setable.
  93. ;;   Fix (let...) bug in tex-mma-dispatch
  94.  
  95. ;; ;; Environment
  96.  
  97. (provide 'tex-mma)
  98. (require 'math)
  99. (require 'tex-mode)
  100.  
  101.  
  102. ;; Constants
  103.  
  104. (defvar tex-mma-process-string
  105.   "math"
  106.   "String to pass to Unix exec function to start Mathematica.")
  107.  
  108. (defvar tex-mma-process-name
  109.   "math"
  110.   "The name of the inferior Mathematica process.
  111. make-shell names the buffer the process name surrounded by `*'s.")
  112.  
  113. (defvar tex-mma-process-buffer
  114.   "*math*"
  115.   "The name of the shell buffer running Mathematica with tex-mma-mode")
  116.  
  117. (defvar tex-mma-info-file
  118.   "/usr8/dan/emacs/info/tex-mma.info"
  119.   "Fully specified location of the tex-mma.info file.")
  120.  
  121.  
  122. ;; Help
  123.  
  124. (autoload 'Info-goto-node "info")
  125. (defun tex-mma-info ()
  126.   (interactive)
  127.   (Info-goto-node (concat "(" tex-mma-info-file ")" "Top")))
  128.  
  129. ;; ;; Startup
  130.  
  131. (defun tex-mathematica ()
  132.   "Set up tex-mma-mode and the generice interface."
  133.   (interactive)
  134.   (tex-mma-setup)
  135.   (tex-mma-startup 'tex-mma-mode))
  136.  
  137. (defun latex-mathematica ()
  138.   "Set up latex-mma-mode and the generic interface."
  139.   (interactive)
  140.   (tex-mma-setup)
  141.   (tex-mma-startup 'latex-mma-mode))
  142.  
  143. (defun plain-tex-mathematica ()
  144.   "Set up plain-tex-mma-mode and the generic interface."
  145.   (interactive)
  146.   (tex-mma-setup)
  147.   (tex-mma-startup 'plain-tex-mma-mode))
  148.  
  149. (defun tex-mma-startup (mode)
  150.   "Set up tex-mma-mode."
  151.   (funcall mode)
  152.   ; We don't enter math-mode in TeX buffer so we must make this variable here
  153.   (make-local-variable 'doing-math-complete-symbol)
  154.   (message (substitute-command-keys
  155.         (concat tex-mma-herald "Use \\[tex-mma-info] for help."))))
  156.  
  157. ;; ;; Data structures
  158.  
  159. ; Not defvar, since the code depends on the values defined here.
  160. (defconst tex-mma-cell-alist-default
  161.   '(("mathematica" .
  162.      (
  163.       ("buffer-go" . tex-mma-math-buffer-go)
  164.       ("recenter" . tex-mma-math-recenter)
  165.       ("replace" . tex-mma-math-replace)
  166.       ("send" . tex-mma-math-send)
  167.       ("send-cell" . tex-mma-math-send-cell)
  168.       ("show" . tex-mma-math-show)
  169.       ("update" . tex-mma-math-update)
  170.       )))
  171.   "Alist of functions for `mathematica' cells.  Used by tex-mma-get-cell-alist to
  172. initialize tex-mma-cell-alist so we can be sure to start fresh.")
  173.  
  174. (defvar tex-mma-cell-alist ()
  175.   "Alist of defined cells.  The entry for each cell is the alist of command names
  176. and corresponding functions.  This is filled in by tex-mma-get-cell-alist from
  177. variables `type'-tex-mma-cell-alist.")
  178.  
  179. (defvar tex-mma-defined-cells ()
  180.   "List of defined cells.
  181. This is filled in by tex-mma-get-defined-cells.")
  182.  
  183. (defconst tex-mma-cell-default "mathematica"
  184.   "Default cell-type for generic operations.")
  185.  
  186. (defvar tex-mma-dereference-path nil
  187.   "List of buffers referenced in cell assembly.
  188. Used by `tex-mma-dereference-buffer' to detect self-reference.")
  189.  
  190. (defvar tex-mma-error-point nil
  191.   "Buffer position where error detected.")
  192.  
  193.  
  194. ;; ;; Initialization
  195.  
  196. (defun tex-mma-version ()
  197.   "Display string indentifying each component of this TeX/Mathematica."
  198.   (interactive)
  199.   (with-output-to-temp-buffer "*Help*" (print-help-return-message))
  200.   (let ((home-buffer (current-buffer))
  201.     list
  202.     type)
  203.     (pop-to-buffer "*Help*")
  204.     (insert tex-mma-version-string)
  205.     (insert "\n")
  206.     (setq list tex-mma-defined-cells)
  207.     (while (setq type (car list))
  208.       (setq list (cdr list))
  209.       (if (equal type "mathematica")
  210.       nil ; We have already displayed this
  211.     (insert (eval (intern (concat type "-tex-mma-version-string")))))
  212.       (insert "\n"))
  213.     (pop-to-buffer home-buffer))
  214.   (bury-buffer "*Help*"))
  215.  
  216. (defvar tex-mma-new-types ()
  217.   "*List of cell types to be added to TeX/Mathematica.")
  218.  
  219. (defun tex-mma-setup ()
  220.   "Run hooks for new cell types and setup TeX/Mathematica data structures."
  221.   (tex-mma-run-hooks)
  222.   (tex-mma-get-cell-alist)
  223.   (tex-mma-get-defined-cells)
  224.   )
  225.  
  226. (defun tex-mma-run-hooks ()
  227.   "Run hooks for new cell types."
  228.   (let ((types tex-mma-new-types)
  229.     type)
  230.     (while (setq type (car types))
  231.       (setq types (cdr types))
  232.       (funcall (intern (concat type "-tex-mma-hook"))) ; Force functions to load
  233.       )))
  234.  
  235. (defun tex-mma-replace-assoc (alist key val)
  236.   "Replace ALIST KEY VALUE, if KEY present, else add KEY VALUE.
  237. Return modified alist."
  238.   (if (assoc key alist)
  239.       (setcdr (assoc key alist) val)
  240.     (setcdr alist (cons (cons key val) (cdr alist))))
  241.   alist)
  242.  
  243. (defun tex-mma-get-cell-alist ()
  244.   "Create tex-mma-cell-alist."
  245.   (setq tex-mma-cell-alist tex-mma-cell-alist-default)
  246.   (if tex-mma-new-types
  247.       (let ((types tex-mma-new-types)
  248.         type)
  249.     (while (setq type (car types))
  250.       (setq types (cdr types))
  251.       (if (equal "mathematica" type)
  252.           (error "You can't add cell type `%s' to TeX/Mathematica" type)
  253.             ; Add functions for a new type
  254.         (message "Adding cell type `%s' ..." type)
  255.         (sleep-for 1)
  256.         (tex-mma-replace-assoc
  257.          tex-mma-cell-alist
  258.          type
  259.          (eval (intern (concat type "-tex-mma-cell-alist")))))))))
  260.       
  261. (defun tex-mma-get-defined-cells ()
  262.   "Fill in list of defined cells."
  263.   (setq tex-mma-defined-cells (mapcar 'car tex-mma-cell-alist)))
  264.  
  265. ;; ;; TeX/Mathematica functions for generic cells
  266.  
  267. (defun tex-mma-dispatch (cell command)
  268.   "Run function for CELL specified by COMMAND."
  269.   (let ((name-function (assoc command (cdr (assoc cell tex-mma-cell-alist)))))
  270.     (if (not name-function)
  271.     (error "Command `%s' not defined for cell type `%s'" command cell)
  272.       (funcall (cdr name-function)))))
  273.  
  274. (defun tex-mma-cell-type ()
  275.   "Returns cell type if contained in tex-mma-defined-cells,
  276. else returns nil."
  277.   (let ((list tex-mma-defined-cells)
  278.     type)
  279.     (catch 'done
  280.       (while (setq type (car list))
  281.     (if (tex-mma-cell-p type)
  282.         (throw 'done t))
  283.     (setq list (cdr list))))
  284.     type))
  285.  
  286. (defun tex-mma-buffer-go ()
  287.   "Go to process buffer.
  288. Process is that of cell containing point, else prompt for process."
  289.   (interactive)
  290.   (if (not tex-mma-new-types)
  291.       (tex-mma-math-buffer-go)
  292.     (let (cell)
  293.       (if (setq cell (tex-mma-cell-type))
  294.       t
  295.     (setq cell (completing-read
  296.             (concat "Buffer (default " tex-mma-cell-default "): ")
  297.      tex-mma-cell-alist nil t nil))
  298.     (if (string-equal cell "")
  299.         (setq cell tex-mma-cell-default)))
  300.       (setq tex-mma-cell-default cell)
  301.       (tex-mma-dispatch cell "buffer-go"))))
  302.  
  303. (defun tex-mma-send ()
  304.   "Send statements constaining point to process.
  305. Statements are delimited by blank lines."
  306.   (interactive)
  307.   (if (not tex-mma-new-types)
  308.       (tex-mma-math-send)
  309.     (let ((cell (completing-read
  310.          (concat "Buffer (default " tex-mma-cell-default "): ")
  311.          tex-mma-cell-alist nil t nil)))
  312.       (if (string-equal cell "")
  313.       (setq cell tex-mma-cell-default))
  314.       (setq tex-mma-cell-default cell)
  315.       (tex-mma-dispatch cell "send"))))
  316.  
  317. (defun tex-mma-send-cell ()
  318.   "Send input to process.
  319. Point must be in a cell."
  320.   (interactive)
  321.   (if (not tex-mma-new-types)
  322.       (tex-mma-math-send-cell)
  323.     (let ((cell (tex-mma-cell-type)))
  324.       (if cell
  325.       (tex-mma-dispatch cell "send-cell")
  326.     (error "Not in a cell")))))
  327.  
  328. (defun tex-mma-replace ()
  329.   "Replace output (if any) with last process result.
  330. Point must be in process cell.
  331. Output (if any) assumed to follow input, separated by blank line."
  332.   (interactive)
  333.   (if (not tex-mma-new-types)
  334.       (tex-mma-math-replace)
  335.     (let ((cell (tex-mma-cell-type)))
  336.       (if cell
  337.       (tex-mma-dispatch cell "replace")
  338.     (error "Not in a cell")))))
  339.  
  340. (defun tex-mma-update ()
  341.   "Send input to process and optionally replace output with result.
  342. Point must be in process cell.
  343. Output (if any) assumed to follow input, separated by blank line." 
  344.   (interactive)
  345.   (if (not tex-mma-new-types)
  346.       (tex-mma-math-update)
  347.     (let ((cell (tex-mma-cell-type)))
  348.       (if cell
  349.       (tex-mma-dispatch cell "update")
  350.     (error "Not in a cell")))))
  351.  
  352. (defun tex-mma-recenter ()
  353.   "Place process buffer input prompt at top of screen.
  354. Process is that of cell containing point, else prompt for process."
  355.   (interactive)
  356.   (if (not tex-mma-new-types)
  357.       (tex-mma-math-recenter)
  358.     (let (cell)
  359.       (if (setq cell (tex-mma-cell-type))
  360.       t
  361.     (setq cell (completing-read
  362.                     (concat "Buffer (default " tex-mma-cell-default "): ")
  363.             tex-mma-cell-alist nil t nil))
  364.     (if (string-equal cell "")
  365.             (setq cell tex-mma-cell-default)))
  366.       (setq tex-mma-cell-default cell)
  367.       (tex-mma-dispatch cell "recenter"))))
  368.  
  369. (defun tex-mma-show ()
  370.   "Make last process output visible.
  371. Process is that of cell containing point, else prompt for process."
  372.   (interactive)
  373.   (if (not tex-mma-new-types)
  374.       (tex-mma-math-show)
  375.     (let (cell)
  376.       (if (setq cell (tex-mma-cell-type))
  377.       t
  378.         (setq cell (completing-read
  379.                     (concat "Buffer (default " tex-mma-cell-default "): ")
  380.             tex-mma-cell-alist nil t nil))
  381.         (if (string-equal cell "")
  382.             (setq cell tex-mma-cell-default)))
  383.       (setq tex-mma-cell-default cell)
  384.       (tex-mma-dispatch cell "show"))))
  385.  
  386. (defun tex-mma-toggle-init ()
  387.   "Toggle the initialization mark of cell."
  388.   (interactive)
  389.   (let ((type (tex-mma-cell-type)))
  390.     (if type
  391.     (tex-mma-toggle-init-type type)
  392.       (error "Not in a cell"))))
  393.  
  394. (defun tex-mma-toggle-init-type (type)
  395.   "Toggle initialization marker of TYPE cell containing point."
  396.   (save-excursion
  397.     (re-search-backward (concat "^\\\\begin\{" type "\}"))
  398.     (goto-char (match-end 0))
  399.     (if (looking-at "\\[\\* Initialization Cell \\*\\]")
  400.     (delete-region (match-beginning 0) (match-end 0))
  401.       (insert "[* Initialization Cell *]")
  402.       )))
  403.  
  404. (defun tex-mma-eval-all-ask ()
  405.   "Optionally evaluate all cells."
  406.   (interactive)
  407.   (tex-mma-eval nil t))
  408.  
  409. (defun tex-mma-eval-all-noask ()
  410.   "Evaluate all cells."
  411.   (interactive)
  412.   (tex-mma-eval nil nil))
  413.  
  414. (defun tex-mma-eval-init-ask ()
  415.   "Optionally evaluate all initialization cells."
  416.   (interactive)
  417.   (tex-mma-eval "\\[\\* Initialization Cell \\*\\]" t))
  418.  
  419. (defun tex-mma-eval-init-noask ()
  420.   "Evaluate all initialization cells."
  421.   (interactive)
  422.   (tex-mma-eval "\\[\\* Initialization Cell \\*\\]" nil))
  423.  
  424. (defun tex-mma-create-cell ()
  425.   "Insert a cell."
  426.   (interactive)
  427.   (let (type)
  428.     (if (not tex-mma-new-types)
  429.     (setq type "mathematica")
  430.       (setq type (completing-read
  431.           (concat "Cell type (default " tex-mma-cell-default "): ")
  432.           tex-mma-cell-alist nil t nil))
  433.       (if (string-equal type "")
  434.       (setq type tex-mma-cell-default)))
  435.     (setq tex-mma-cell-default type)
  436.     (tex-mma-create-cell-type type)))
  437.  
  438. (defun tex-mma-create-cell-type (type)
  439.   "Insert TYPE cell in buffer."
  440.   (if (tex-mma-cell-p type)
  441.       (error "Cell already exists")
  442.     (if (not (bolp))
  443.     (progn
  444.       (open-line 1)
  445.       (forward-line 1)))
  446.     (insert (concat "\\begin{" type "}\n\n\\end{" type "}\n"))
  447.     (beginning-of-line)
  448.     (previous-line 2)))
  449.  
  450. (defun tex-mma-forward-cell ()
  451.   "Move to next cell.
  452. Return type of cell, else return nil."
  453.   (interactive)
  454.     (let ((cur-pos (point))
  455.       (list tex-mma-defined-cells)
  456.       (cell-pos (point-max))
  457.       cell-type
  458.       type)
  459.       (while (setq type (car list))
  460.     (setq list (cdr list))
  461.     (setq new-pos (tex-mma-next-cell-start type))
  462.     (if (not (equal new-pos cur-pos))
  463.         (if (> new-pos cell-pos)
  464.         nil
  465.           (setq cell-pos new-pos)
  466.           (setq cell-type type))))
  467.       (if (equal cell-pos (point-max))
  468.       nil; No more cells
  469.     (goto-char cell-pos)
  470.     cell-type)))
  471.  
  472. (defun tex-mma-backward-cell ()
  473.   "Move to previous cell.
  474. Return type of cell found, else return nil."
  475.   (interactive)
  476.     (let ((cur-pos (point))
  477.       (list tex-mma-defined-cells)
  478.       (cell-pos (point-min))
  479.       cell-type
  480.       type)
  481.       (while (setq type (car list))
  482.     (setq list (cdr list))
  483.     (setq new-pos (tex-mma-previous-cell-start type))
  484.     (if (not (equal new-pos cur-pos))
  485.         (if (< new-pos cell-pos)
  486.         nil
  487.           (setq cell-pos new-pos)
  488.           (setq cell-type type))))
  489.       (if (equal cell-pos (point-min))
  490.       nil ; No more cells
  491.     (goto-char cell-pos)
  492.     cell-type)))
  493.  
  494. (defun tex-mma-eval (kind ask)
  495.   "Optionally evaluate all KIND cells.
  496. If ASK is non-nil, then ask whether each KIND cell is to be evaluated,
  497. else evaluate each KIND cell.  If KIND is nil, evaluate all cells."
  498.   (let (type bypass display-start display-end cur-pos)
  499.     (save-excursion
  500.       (goto-char (point-min))
  501.       (while (setq type (tex-mma-forward-cell))
  502.     (if (tex-mma-reference-p type)
  503.         (setq bypass t) ; Skip cells that refer to other cells
  504.       (forward-line -1)
  505.       (if (not (looking-at (concat "^\\\\begin\{" type "\}" kind)))
  506.           (progn
  507.         (forward-line 1) ; Don't want the same cell next time
  508.         nil) ; Wrong kind of cell
  509.                     ; We have a cell of the right kind
  510.         (setq display-start (point))
  511.         (goto-char (tex-mma-cell-end type))
  512.         (forward-line 1) ; We need to include cell trailer in narrowed region
  513.         (end-of-line)    ; ..
  514.         (setq display-end (point))
  515.         (forward-line 0)
  516.         (unwind-protect
  517.         (progn
  518.           (tex-mma-recenter)
  519.           (narrow-to-region display-start display-end)
  520.           (goto-char (point-min))
  521.           (recenter 1) ; force display, just in case...
  522.           (forward-line 1)
  523.           (if (and ask (not (y-or-n-p "Evaluate this cell? ")))
  524.               t
  525.             (tex-mma-update)
  526.             (tex-mma-show)))
  527.           (widen) ; If user aborts evaluation at prompt
  528.           ) ; unwind-protect
  529.         ) ; if in a valid cell
  530.       ) ; if in a cell without references
  531.     ) ; while still types to check
  532.  
  533.       ) ; save-excursion
  534.     (widen)
  535.     (beep)
  536.     (if bypass
  537.     (message
  538.     "Evaluation of cells finished (cells containing cell references were bypassed)")
  539.       (message "Evaluation of cells finished"))
  540.     ) ; let
  541.   )
  542.  
  543. (defun tex-mma-do-completion ()
  544.   (interactive)
  545.   (let ((type (tex-mma-cell-type)))
  546.     (if (and type (tex-mma-insert-complete-name type))
  547.     t ; Cell filename or partname completion
  548.       ; Mathematica completion
  549.       (tex-mma-math-start-process)
  550.       (math-complete-symbol))))
  551.  
  552. (defun tex-mma-cell-start (type)
  553.   "Return position of start of cell of TYPE containing point."
  554.   (let ((begin-re (concat "^\\\\begin\{" type "\}")))
  555.   (save-excursion
  556.     (if (not (looking-at begin-re))
  557.     (re-search-backward begin-re))
  558.     (forward-line 1)
  559.     (point))))
  560.  
  561. (defun tex-mma-cell-end (type)
  562.   "Return position of end of cell of TYPE containing point."
  563.   (let ((end-re (concat "^\\\\end\{" type "\}")))
  564.     (save-excursion
  565.       (re-search-forward end-re)
  566.       (forward-line -1)
  567.       (end-of-line)
  568.       (point))))
  569.  
  570. (defun tex-mma-previous-cell-start (type)
  571.   "Get start of preceding cell of TYPE.  If none, return current position."
  572.   (let ((cur-pos (point))
  573.     (start nil)
  574.     (begin-re (concat "^\\\\begin\{" type "\}"))
  575.     (end-re (concat "^\\\\end\{" type "\}")))
  576.     (save-excursion
  577.       (if (not (re-search-backward end-re (point-min) t))
  578.       cur-pos
  579.     (if (tex-mma-cell-p type)
  580.         (progn
  581.           (re-search-backward begin-re)
  582.           (forward-line 1)
  583.           (point))
  584.       cur-pos)))))
  585.           
  586. (defun tex-mma-next-cell-start (type)
  587.   "Get start of next cell of TYPE.  If none, return current position."
  588.   (let ((cur-pos (point))
  589.     (start nil)
  590.         (begin-re (concat "^\\\\begin\{" type "\}"))
  591.         (end-re (concat "^\\\\end\{" type "\}")))
  592.     (save-excursion
  593.       (if (re-search-forward begin-re (point-max) t)
  594.       (progn
  595.         (if (not (tex-mma-cell-p type))
  596.         cur-pos)
  597.         (forward-line 1)
  598.         (point))
  599.     cur-pos))))
  600.  
  601. (defun tex-mma-cell-p (type)
  602.   "Returns t if point is in a TeX/Mathematica cell of type, else returns nil."
  603.   (let ((begin-re (concat "^\\\\begin\{" type "\}"))
  604.     (end-re (concat "^\\\\end\{" type "\}"))
  605.     found)
  606.     (catch 'done
  607.       (save-excursion
  608.     (if (re-search-backward begin-re (point-min) t)
  609.         (setq found (point))
  610.       (throw 'done nil))) ; No \begin{...}
  611.       (save-excursion
  612.     (if (re-search-backward end-re found t)
  613.         (throw 'done nil))) ; Intervening \end{...}
  614.       (save-excursion
  615.     (if (re-search-forward end-re (point-max) t)
  616.         (setq found (point))
  617.       (throw 'done nil))) ; No \end{...}
  618.       (save-excursion
  619.     (if (re-search-forward begin-re found t)
  620.         (throw 'done nil) ; Intervening \begin{...}
  621.       (throw 'done t)))))) ; In a cell
  622.     
  623. (defun tex-mma-delete-output (type)
  624.   "Delete current TYPE output (if any).  Assumes point in TYPE cell.
  625. Output assumed to follow input, separated by a blank line.
  626. Input may not contain blank lines."
  627.   (let ((out-start (tex-mma-output-p type)))
  628.     (if out-start
  629.     (delete-region out-start (tex-mma-cell-end type))
  630.       t)))
  631.  
  632. (defun tex-mma-output-p (type)
  633.   "Return start of TYPE output text if present, else return nil.
  634. Assumes point in TYPE cell.
  635. Output assumed to follow input, separated by a blank line.
  636. Input may not contain blank lines."
  637.   (save-excursion
  638.     (goto-char (tex-mma-cell-start type))
  639.     (if (re-search-forward "^\n" (tex-mma-cell-end type) t)
  640.     (progn
  641.       (forward-line -2)
  642.       (end-of-line)
  643.       (point))
  644.       nil)))
  645.  
  646. ;; ;; TeX/Mathematica functions for package assembly
  647.  
  648. (defun tex-mma-assemble-cell ()
  649.   "Assemble references in cell."
  650.   (interactive)
  651.   (let ((type (tex-mma-cell-type))
  652.     files parts file part)
  653.     (if (not type) (error "Not in a cell"))
  654.     (if (not (tex-mma-reference-p type)) (error "Cell contains no references"))
  655.     (save-excursion
  656.       (goto-char (tex-mma-cell-start type))
  657.       (forward-line -1)
  658.       (if (not (looking-at (concat "^\\\\begin{" type "}.*<.*:.*>")))
  659.       (error "Cell is not marked"))
  660.       (setq files (tex-mma-get-filenames type))
  661.       (setq file (tex-mma-get-filename files))
  662.       (if (not file) (error "Ambiguous filename"))
  663.       (setq parts (tex-mma-get-partnames type file files))
  664.       (setq part (tex-mma-get-partname parts))
  665.       (if  (not part) (error "Ambiguous partname"))
  666.       ) ; save-excursion
  667.     (setq cell-file file)
  668.     (if (not (equal part "")) (setq cell-file (concat cell-file ":" part)))
  669.     (if (bufferp (get-buffer file))
  670.     (progn
  671.       (setq prompt
  672.         (concat
  673.          "Cell buffer `"
  674.          cell-file
  675.          "' exists. Overwrite it? "))
  676.       (if (not (y-or-n-p prompt))
  677.           (error "Cell assembly cancelled"))))
  678.     (message "Assembling cell `%s' ..." cell-file) ; (sleep-for 3)
  679.     (tex-mma-assemble-package-type type file files parts part)
  680.     ) ; let
  681.   )
  682.  
  683. (defun tex-mma-assemble-package (&optional this-type this-file overwrite)
  684.   "Assemble text into a package.
  685. Optional arguments (useful for batch processing)
  686. THIS-TYPE cells;
  687. THIS-FILE package filename;
  688. OVERWRITE, if not nil package filename buffer will be overwritten without asking."
  689.   (interactive)
  690.   (let (type file files parts prompt)
  691.     (if this-type
  692.     (setq type this-type)
  693.       (if (not tex-mma-new-types)
  694.       (setq type "mathematica")
  695.     (setq type (completing-read
  696.             (concat "Package type (default " tex-mma-cell-default ": ")
  697.             tex-mma-cell-alist nil t nil))
  698.     (if (string-equal type "")
  699.         (setq type tex-mma-cell-default))))
  700.     (setq tex-mma-cell-default type)
  701.     (setq files (tex-mma-get-filenames type))
  702.     (if (not files) (error "No complete package filenames found"))
  703.     (if this-file
  704.     (progn
  705.       (if (assoc this-file files)
  706.           (setq file this-file)
  707.         (error "Package filename not found: `%s'" this-file)))
  708.       (if (equal 1 (length files))
  709.       (setq file (car (car files)))
  710.     (setq file
  711.           (completing-read
  712.            "Package filename (<space> to see filenames): "
  713.            files nil t nil))))
  714.     (if (equal "" file)
  715.     (error "No package filename specified"))
  716.     (setq parts (tex-mma-get-partnames type file files))
  717.     (if overwrite
  718.     t ; Overwrite file if it necessary
  719.       (if (bufferp (get-buffer file))
  720.       (progn
  721.         (setq prompt (concat
  722.               "Package buffer `"
  723.               file
  724.               "' exists. Overwrite it ? "))
  725.         (if (not (y-or-n-p prompt))
  726.           (error "Package assembly cancelled")))))
  727.     (message "Assembling package filename `%s' ..." file) ;(sleep-for 1)
  728.     (tex-mma-assemble-package-type type file files parts)
  729.     ))
  730.  
  731. (defun tex-mma-assemble-package-type (type file files parts &optional part)
  732.   "Assemble TYPE cells marked with filename FILE in buffer FILE,
  733. which is overwritten if it exists. Alists FILES and PARTS are
  734. used for name completion (see `tex-mma-get-filename' and `tex-mma-get-partname').
  735. If optional string PART is non-nil, then assembles cells FILE:PART in buffer
  736. FILE:PART instead."
  737.   (let ((home-buffer (current-buffer))
  738.     cell-file cell-found
  739.     this-part this-file part-file part-files cell-type problem)
  740.     (setq tex-mma-error-point (point)) ; Go here if no error
  741.     (if (not part) (setq part ""))
  742.     (if (equal part "")
  743.     (setq cell-file file)
  744.       (setq cell-file (concat file ":" part)))
  745.     (if (get-buffer cell-file) ; Start fresh
  746.     (save-excursion
  747.       (set-buffer cell-file)
  748.       (erase-buffer)
  749.       (set-buffer home-buffer)))
  750.     (unwind-protect ; So part files will be deleted even if errors or abort
  751.     (progn
  752.       (save-excursion
  753.         (goto-char (point-min))
  754.         (while (setq cell-type (tex-mma-forward-cell))
  755.           (if (not (equal type cell-type))
  756.           nil ;
  757.         (forward-line -1) ; Move to \begin{...
  758.         (if (not (looking-at (concat "^\\\\begin{" type "}.*<.*:.*>")))
  759.             (forward-line 1) ; So we go to next cell next time through
  760.           ; We have a marked cell
  761.           (setq this-file (tex-mma-get-filename files))
  762.           (cond
  763.            ((not this-file)
  764.             (setq tex-mma-error-point (point))
  765.             (error "Ambiguous filename"))
  766.            ((not (equal file this-file))
  767.             (forward-line 1)) ; So we go to next cell next time through
  768.            (t ; We have a cell of the right package filename
  769.             (setq this-part (tex-mma-get-partname parts))
  770.             (cond
  771.              ((not this-part)
  772.               (setq tex-mma-error-point (point))
  773.               (error "Ambiguous partname"))
  774.              (t
  775.               (forward-line 1) ; Move into cell
  776.               (if (equal this-part part)
  777.               (progn
  778.                 (setq part-file cell-file)
  779.                 (setq cell-found t))
  780.             (setq part-file (concat file ":" this-part))
  781.             (if (not (tex-mma-string-mem part-file part-files))
  782.                 (setq part-files (cons part-file part-files))))
  783.               ) ; proper partname
  784.              ) ; cond
  785.             (tex-mma-append-cell-to-buffer type part-file)
  786.             ) ; if cell marked with requested filename
  787.            ) ; cond
  788.           ) ; if a marked cell
  789.         ) ; if a TYPE cell
  790.           ) ; while still cells to process
  791.         ) ; save excursion
  792.       (if (not cell-found)
  793.           (error "No `%s' package cell `%s:%s' found" type file part)
  794.         (while (tex-mma-dereference-buffer cell-file files parts))
  795.         ) ; if parts found
  796.       ; Package assembled.  Make it visible and move to its start
  797.       (switch-to-buffer-other-window cell-file)
  798.       (tex-mathematica)
  799.       (setq tex-mma-error-point (point-min))
  800.       (message "`%s' assembled" cell-file)
  801.       ) ; progn
  802.       ; unwind-protect forms:  Delete part this-files
  803.       (while (setq part-file (car part-files))
  804.     (setq part-files (cdr part-files))
  805.     (condition-case nil ; In case a buffer was not actually created
  806.         (kill-buffer part-file)
  807.       (error nil)))
  808.       (goto-char tex-mma-error-point)
  809.       ) ; unwind-protect
  810.     ) ; let
  811.   ) ; done
  812.  
  813. (defun tex-mma-append-cell-to-buffer (type buffer)
  814.   "Append text of TYPE cell containing point to BUFFER."
  815.   (if (not (tex-mma-cell-p type))
  816.       (error "Not in a cell.")
  817.     (let ((home-buffer (current-buffer))
  818.       (start (tex-mma-cell-start type))
  819.       (end (tex-mma-cell-end type)))
  820.       (save-excursion
  821.     (set-buffer (get-buffer-create buffer))
  822.     (goto-char (point-max))
  823.     (insert-buffer-substring home-buffer start end)
  824.     (insert "\n")
  825.     ))))
  826.  
  827. (defun tex-mma-dereference-buffer (buffer files parts &optional buffers)
  828.   "Resolve all references in BUFFER using FILES and PARTS for name completion.
  829. If optional BUFFERS is nil, initialize global variable `tex-mma-dereference-path'
  830. with BUFFER. If BUFFERS is non-nil, add BUFFER to `tex-mma-dereference-path'.
  831. Use `tex-mma-dereference-path' to check for self-reference and report error
  832. if detected,"
  833.   (let ((ref-found nil)
  834.     (home-buffer (current-buffer))
  835.     path-to-here
  836.     ref-indent ref-buf)
  837.     (set-buffer buffer)
  838.     (goto-char (point-min))
  839.     (if buffers
  840.     t
  841.       (setq buffers t)
  842.       (setq tex-mma-dereference-path (list buffer))
  843.       )
  844.     (setq path-to-here tex-mma-dereference-path)
  845.     (while (re-search-forward "^ *\t*<[^:].*:[^>].*>$" (point-max) t)
  846.       (setq re-found 1)
  847.       (beginning-of-line)
  848.       (setq ref-indent (tex-mma-get-reference-indentation))
  849.       (setq ref-buf
  850.         (concat
  851.          (tex-mma-get-filename files)
  852.          ":"
  853.          (tex-mma-get-partname parts)))
  854.       (if (tex-mma-string-mem ref-buf path-to-here)
  855.       (tex-mma-dereference-error (cons ref-buf path-to-here)))
  856.       (setq tex-mma-dereference-path (cons ref-buf path-to-here))
  857.       (while (tex-mma-dereference-buffer ref-buf files parts buffers))
  858.       (kill-line 1) ; Remove reference line
  859.       (insert-buffer ref-buf)
  860.       (if ref-indent (indent-rigidly (point) (mark) ref-indent))
  861.       )
  862.     (setq tex-mma-dereference-path path-to-here)
  863.     (set-buffer home-buffer)
  864.     ref-found))
  865.  
  866. (defun tex-mma-dereference-error (path)
  867.   "Report package self-reference error, in PATH"
  868.   (let ((cell (car path))
  869.     (home-buffer (current-buffer))
  870.     to-cell from-cell)
  871.     (setq to-cell cell)
  872.     (with-output-to-temp-buffer "*Help*" (message ""))
  873.     (pop-to-buffer "*Help*")
  874.     (insert "Self-reference detected assembling TeX/Mathematica cell\n\n")
  875.     (insert (concat "\t\t" to-cell "\n\n"))
  876.     (insert "Here is how the self-reference happened:\n\n")
  877.     (setq path (reverse path))
  878.     (setq from-cell (car path))
  879.     (insert (concat "\t" from-cell "\n"))
  880.     (while (setq path (cdr path))
  881.       (setq to-cell (car path))
  882.       (if (equal cell to-cell)
  883.       (insert (concat " !!! ->\t   -->\t" to-cell "\n"))
  884.     (insert (concat "\t   -->\t" to-cell "\n")))
  885.       (setq from-cell to-cell)
  886.       )
  887.     (pop-to-buffer home-buffer)
  888.     (error "Self-reference detected")
  889.     ))
  890.  
  891. (defun tex-mma-get-reference-indentation ()
  892.   "Return indentation of reference on current line.
  893. Line assumed tabified."
  894.   (let (start end)
  895.     (save-excursion
  896.       (beginning-of-line)
  897.       (setq start (point))
  898.       (search-forward "<")
  899.       (untabify start (point))
  900.       (setq end (point))
  901.       (beginning-of-line)
  902.       (tabify (point) end)
  903.       (- end start 1) ; -1 since search places point after `>'
  904.       )))
  905.  
  906. (defun tex-mma-insert-complete-name (type)
  907.   "Insert complete name in buffer, for cell of type TYPE.
  908. Return t if successful, else nil."
  909.   (interactive)
  910.   (let ((here (point))
  911.     start end name text files parts
  912.     )
  913.     (save-excursion
  914.       (beginning-of-line)
  915.       (cond
  916.        ((and ; partname
  917.      (or
  918.       (re-search-forward (concat "^\\\\begin{" type "}<.*:[^\t]*") here t)
  919.       (re-search-forward (concat "^[ \t]*<.*:[^\t]*") here t))
  920.      (equal here (point)))
  921.     (if (not (setq files (tex-mma-get-filenames type)))
  922.             (error "No package filenames in document"))
  923.     (search-backward "<")
  924.         (forward-char 1)
  925.         (setq start (point))
  926.     (search-forward ":")
  927.     (forward-char -1)
  928.         (setq text (buffer-substring start (point)))
  929.     (if (not (setq name (tex-mma-complete-name text files)))
  930.             (error "No matching package filename found"))
  931.     (setq parts (tex-mma-get-partnames type name files))
  932.     (forward-char 1)
  933.         (setq start (point)) ; New start, for partname deletion
  934.     (setq text (buffer-substring (point) here))
  935.     (if (not (setq name (tex-mma-complete-name
  936.                  (concat text "...")
  937.                  parts)))
  938.             (error "No matching package partname found"))
  939.         (cond
  940.          ((equal t name) ; Text is complete
  941.           (setq name text)
  942.           )
  943.          ((equal t (try-completion name parts)) ; Completion is exact
  944.           )
  945.          (t ; Else, get completion
  946.           (setq name
  947.                 (completing-read
  948.                  "Partname (<space> to see partnames): "
  949.                  parts nil t name))
  950.           )
  951.          ) ; cond: what kind of partname completion was done
  952.         (delete-region start here)
  953.         (insert (concat name ">"))
  954.     ) ; End of partname completion
  955.        ((and ; filename
  956.      (or (re-search-forward (concat "^\\\\begin{" type "}<[^ \t]*") here t)
  957.          (re-search-forward "^[ \t]*<[^ \t]*" here t))
  958.      (equal here (point)))
  959.     (if (not (setq files (tex-mma-get-filenames type)))
  960.         (error "No package filenames in document"))
  961.     (re-search-backward "<")
  962.     (forward-char 1)
  963.     (setq start (point))
  964.     (setq text (buffer-substring start here))
  965.     (if (not (setq name (tex-mma-complete-name
  966.                  (concat text "...") ; completion form
  967.                  files)))
  968.         (error "No matching package filename found"))
  969.     (cond
  970.      ((equal t name) ; Text is complete
  971.       (setq name text)
  972.       )
  973.      ((equal t (try-completion name files)) ; Completion is exact
  974.       )
  975.      (t ; Else, get completion
  976.       (setq name
  977.         (completing-read
  978.          "Filename (<space> to see filenames): "
  979.          files nil t name))
  980.       (if (equal "" name) (error "")) ; No response means no completion
  981.       )
  982.      ) ; cond: what kind of filename completion was done
  983.     (delete-region start here)
  984.     (insert (concat name ":"))
  985.     ) ; End of filename completion
  986.        (t
  987.     (error "Nothing to complete")
  988.     )
  989.        ) ; cond: what kind of completion to do
  990.       ) ; save-excursion
  991.     (if (not name)
  992.     nil
  993.       (goto-char (+ (point) (length name) 1))
  994.       t)))
  995.  
  996. (defun tex-mma-get-filenames (type)
  997.   "Return alist of package filenames for cells of type TYPE."
  998.   (let (cell-type file files)
  999.     (save-excursion
  1000.       (goto-char (point-min))
  1001.       (while (setq cell-type (tex-mma-forward-cell))
  1002.     (if (not (equal type cell-type))
  1003.         nil
  1004.       (forward-line -1)
  1005.       (if (not (looking-at (concat "^\\\\begin{" type "}.*<.*>")))
  1006.           (forward-line 1) ; Cell not marked.  Get set for next one
  1007.         (if (setq file (tex-mma-get-filename)) ; Only unabbreviated names
  1008.         (if files
  1009.             (if (assoc file files)
  1010.             nil ; already only
  1011.               (setq files (cons (list file) files))) ; Add to alist
  1012.           (setq files (list (list file))))) ; Start alist
  1013.         (forward-line 1)
  1014.         ) ; if a marked cell
  1015.       ) ; if cell of type TYPE
  1016.     ) ; while cell to look at
  1017.       ) ; save-excursion
  1018.     files
  1019.     )) ; let and done
  1020.  
  1021. (defun tex-mma-complete-name (text alist &optional exact)
  1022.   "Get full name corresponding to TEXT.
  1023. If text is a string ending in `...',
  1024. then the substring preceding the `...' is used with try-completion on ALIST.
  1025. An exact match is required if optional EXACT is t.
  1026. If text is just `...' and alist is length 1, then the car of its single element
  1027. is returned.
  1028. Oherwise nil is returned."
  1029.   (let (name try-name)
  1030.     (if (not (string-match "\\(\\.\\.\\.$\\)" text))
  1031.     (setq name text) ; don't do completion on full names
  1032.       (if (and
  1033.        (eq 0 (match-beginning 1)) ; just "..."
  1034.        (eq 1 (length alist))) ; a single package filename
  1035.       (setq name (car (car alist)))
  1036.     (setq try-name (substring text 0 (match-beginning 1)))
  1037.     (setq name (try-completion try-name alist)))
  1038.       (cond
  1039.        ((equal t name)
  1040.     (setq name try-name))
  1041.        ((and
  1042.      exact
  1043.      (not (equal t (try-completion name alist))))
  1044.     (setq name nil)))) ; Not an exact match, so error
  1045.     name))
  1046.  
  1047. (defun tex-mma-get-partnames (type file files)
  1048.   "Return alist of partnames for TYPE package FILE, using FILES for
  1049. filename completion."
  1050.   (let (cell-end cell-type cell-file part parts)
  1051.     (setq tex-mma-error-point (point))
  1052.     (unwind-protect
  1053.     (save-excursion
  1054.       (goto-char (point-min))
  1055.       (while (setq cell-type (tex-mma-forward-cell))
  1056.         (if (not (equal type cell-type))
  1057.         nil ; Wrong type
  1058.           (setq cell-end (tex-mma-cell-end type))
  1059.           (forward-line -1)
  1060.           (if (not (looking-at
  1061.                        "^\\\\begin{.+}.*<[^:].*:.*>"))
  1062.           (forward-line 1) ; Not a marked cell
  1063.         (setq cell-file (tex-mma-get-filename files))
  1064.         (if (not (equal file cell-file))
  1065.             (forward-line 1) ; Wrong file
  1066.           (while (and
  1067.               (<= (point) cell-end)
  1068.               (or
  1069.                (re-search-forward
  1070.                 "^\\\\begin{.+}.*<[^:].*:.*>" cell-end t)
  1071.                (re-search-forward
  1072.                 "^ *\t*<[^:].*:.*>" cell-end t)))
  1073.             (beginning-of-line) ; We have a filename-partname reference
  1074.             (if (not (setq file (tex-mma-get-filename files)))
  1075.              (progn
  1076.               (setq tex-mma-error-point (point))
  1077.               (error "Ambiguous filename")))
  1078.             (if (not (equal cell-file file))
  1079.             (progn
  1080.               (setq tex-mma-error-point (point))
  1081.               (error "Reference must match cell filename: `%s'"
  1082.                  cell-file)))
  1083.             (setq part (tex-mma-get-partname))
  1084.             (if (not part)
  1085.             nil ; Need full (unabbreviated) parts only, for alist
  1086.               (if parts ; Update alist
  1087.               (if (or
  1088.                    (equal part "")
  1089.                    (tex-mma-string-mem part parts))
  1090.                   nil; already on list
  1091.                 (setq parts (append (list part) parts))) ; Add to alist
  1092.             (if (not (equal part ""))
  1093.                 (setq parts (list part)))) ; Create alist
  1094.               ) ; if an unabbreviated part              
  1095.             (forward-line 1)
  1096.             ) ; while references to process in this cell
  1097.           ) ; if a marked cell of this FILE
  1098.         ) ; if a marked cell
  1099.           ) ; if a TYPE cell
  1100.         ) ; while cells to process
  1101.       ); save-excursion
  1102.       (goto-char tex-mma-error-point) ; unwind-protect form
  1103.       ) ; unwind-protect
  1104.     (setq parts (mapcar 'list parts)) ; Make list into an alist
  1105.     parts
  1106.     ) ; let
  1107.   ) ; done
  1108.  
  1109. (defun tex-mma-get-filename (&optional alist)
  1110.   "Get filename in package reference on current line.
  1111. If optional ALIST is supplied, use it for name completion.
  1112. Return nil if no name or error in name."
  1113.   (let ((match-re "\\(<\\)[^:]*\\(:\\)")
  1114.     (abbrev-re "\\.\\.\\.")
  1115.     beg text)
  1116.     (save-excursion
  1117.       (beginning-of-line)
  1118.       (setq beg (point))
  1119.       (end-of-line)
  1120.       (setq text (buffer-substring beg (point)))
  1121.       (string-match match-re text)
  1122.       (setq text (substring text (+ 1 (match-beginning 1)) (+ -1 (match-end 2))))
  1123.       ) ; save excursion
  1124.     (if alist
  1125.     (tex-mma-complete-name text alist t)
  1126.       ; if no alist, then only full filenames allowed
  1127.       (if (string-match abbrev-re text)
  1128.       nil
  1129.     text))))
  1130.  
  1131. (defun tex-mma-get-partname (&optional alist)
  1132.   "Get partname in package reference on current line.
  1133. If optional ALIST is supplied, use it for name completion.
  1134. Return nil if no name or error in name."
  1135.   (let ((match-re "\\(:\\)\\([^>]*\\)")
  1136.     (abbrev-re "\\.\\.\\.")
  1137.     beg text)
  1138.     (save-excursion
  1139.       (beginning-of-line)
  1140.       (setq beg (point))
  1141.       (end-of-line)
  1142.       (setq text (buffer-substring beg (point)))
  1143.       (string-match match-re text)
  1144.       (setq text (substring text (+ 1 (match-beginning 1)) (match-end 2)))
  1145.       ) ; save excursion
  1146.     (if alist
  1147.     (tex-mma-complete-name text alist t)
  1148.       ; if no alist, then only full filenames allowed
  1149.       (if (string-match abbrev-re text)
  1150.       nil
  1151.     text))))
  1152.  
  1153. (defun tex-mma-string-mem (element list) ; memq doesn't work for strings
  1154.   "Returns t if string ELEMENT is in LIST of strings, else returns nil."
  1155.   (let (try)
  1156.     (catch 'done
  1157.       (while (setq try (car list))
  1158.     (setq list (cdr list))
  1159.     (if (equal element try)
  1160.         (throw 'done t)))
  1161.       nil)))
  1162.  
  1163. (defun tex-mma-reference-p (type)
  1164.   "Return t if TYPE cell contains a cell reference, else retrun nil."
  1165.   (save-excursion
  1166.     (goto-char (tex-mma-cell-start type))
  1167.     (if (re-search-forward "^ *\t*<[^:].*:[^>].*>$" (tex-mma-cell-end type) t)
  1168.     t
  1169.       nil)))
  1170.  
  1171. ;; ;; TeX/Mathematica functions for "mathematica" cells
  1172.  
  1173. (defun tex-mma-math-start-process ()
  1174.   "Start up Mathematica in math mode, if necessary."
  1175.   (if (tex-mma-math-start-process-p)
  1176.       nil
  1177.     (let ((home-buffer (current-buffer)))
  1178.       (math)
  1179.       ; Wait until Mathematica startup is done
  1180.       (while (not (looking-at "^In\\[[0-9]+\\]:=\\s *$"))
  1181.     (sit-for 1)
  1182.     (goto-char (point-max))
  1183.     (beginning-of-line))
  1184.       (goto-char (point-max))
  1185.       (pop-to-buffer home-buffer)))
  1186.   (message ""))
  1187.  
  1188. (defun tex-mma-math-start-process-p ()
  1189.   (if (get-buffer-process tex-mma-process-buffer)
  1190.       t
  1191.     nil))
  1192.  
  1193. (defun tex-mma-math-buffer-go ()
  1194.   "Go to Mathematica buffer."
  1195.   (interactive)
  1196.   (tex-mma-math-start-process)
  1197.   (tex-mma-math-pop-to-buffer))
  1198.  
  1199. (defun tex-mma-math-send ()
  1200.   "Send Mathematica statements containing point to Mathematica subshell.
  1201. Statements are delimited by blank lines."
  1202.   (interactive)
  1203.   (tex-mma-math-start-process)
  1204.   (let ((start (tex-mma-math-start))
  1205.     (end (tex-mma-math-end))
  1206.     (home-buffer (current-buffer)))
  1207.     (tex-mma-math-pop-to-buffer)
  1208.     (goto-char (point-max))
  1209.     (insert-buffer-substring home-buffer start end)))
  1210.  
  1211. (defun tex-mma-math-send-cell ()
  1212.   "Send input to Mathematica.  Point must be in a cell.
  1213. Input is scaned for syntax errors, using check-math-syntax."
  1214.   (interactive)
  1215.   (if (not (tex-mma-cell-p "mathematica"))
  1216.       (error "Not in Mathematica cell"))
  1217.   (if (tex-mma-reference-p "mathematica")
  1218.       (error (concat
  1219.           "References in cell.  Assemble with "
  1220.           (substitute-command-keys "\\[tex-mma-assemble-cell]"))))
  1221.   (tex-mma-math-start-process)
  1222.   (let ((home-buffer (current-buffer))
  1223.     start end)
  1224.     (save-excursion
  1225.       (goto-char (tex-mma-cell-start "mathematica"))
  1226.       (setq start (point))
  1227.       (if (not (setq end (tex-mma-output-p "mathematica")))
  1228.       (setq end (tex-mma-cell-end "mathematica"))))
  1229.     (set-syntax-table math-mode-syntax-table) ; Run math-mode syntax checks
  1230.     (check-math-syntax start end)             ; ..
  1231.     (set-syntax-table TeX-mma-mode-syntax-table)  ; ..
  1232.     (tex-mma-math-pop-to-buffer)
  1233.     (goto-char (point-max))
  1234.     (insert-buffer-substring home-buffer start end)
  1235.     (setq math-send-filter-active t)
  1236.     (unwind-protect
  1237.     (unwind-protect
  1238.         (progn
  1239.           (math-send-input)
  1240.           (while math-send-filter-active
  1241.         (sit-for 1) ; Let Mathematica process filter work
  1242.         ))
  1243.       ;; math-send-input unwind-protect tail
  1244.       (save-excursion
  1245.         (if (not (memq math-send-filter-status '(normal blank-line-added)))
  1246.         (error "Problem in math-send..."))))
  1247.       ;; unwind-protect tail
  1248.       (if (memq math-send-filter-status '(normal blank-line-added premature-output))
  1249.       (pop-to-buffer home-buffer) ; Return to TeX buffer
  1250.     )                             ; .. else stay in Mma buffer to fix error
  1251.       )))
  1252.  
  1253. (defun tex-mma-math-replace ()
  1254.   "Replace output (if any) with last Mathematica result. Point must be in a cell.
  1255. Output assumed to follow input, separated by a blank line."
  1256.   (interactive)
  1257.   (if (not (tex-mma-cell-p "mathematica"))
  1258.       (error "Not in Mathematica cell"))
  1259.   (tex-mma-math-start-process)
  1260.   (save-excursion
  1261.     (tex-mma-delete-output "mathematica")
  1262.     (tex-mma-math-get-output)
  1263.     ))
  1264.  
  1265. (defun tex-mma-math-update ()
  1266.   "Send input to Mathematica and optionally replace output with result.
  1267. Point must be in cell.  Output assumed to follow input, separated by a blank line."
  1268.   (interactive)
  1269.   (if (not (tex-mma-cell-p "mathematica"))
  1270.       (error "Not in Mathematica cell"))
  1271.   (tex-mma-math-send-cell)
  1272.   ; We need to wait for Mathematica's output anyhow, so we might as well ask
  1273.   (if (y-or-n-p "Replace output? ")
  1274.       (tex-mma-math-replace)
  1275.     t))
  1276.  
  1277. (defun tex-mma-math-show ()
  1278.   "Make last Mathematica output visible."
  1279.   (interactive)
  1280.   (tex-mma-math-start-process)
  1281.   (let ((home-buffer (current-buffer)))
  1282.     (tex-mma-math-pop-to-buffer)
  1283.     (goto-char (point-max))
  1284.     (recenter)
  1285.     (pop-to-buffer home-buffer)))
  1286.  
  1287. (defun tex-mma-math-find-error ()
  1288.   "Go to error in .m file reported in Mathematica buffer."
  1289.   (interactive)
  1290.   (tex-mma-math-buffer-go)
  1291.   (find-math-error))
  1292.  
  1293. (defun tex-mma-math-recenter ()
  1294.   "Place shell-mma-buffer input prompt at top of screen."
  1295.   (interactive)
  1296.   (tex-mma-math-start-process)
  1297.   (let ((home-buffer (current-buffer)))
  1298.     (tex-mma-math-pop-to-buffer)
  1299.     (goto-char (point-max))
  1300.     (recenter 0)
  1301.     (pop-to-buffer home-buffer)))
  1302.  
  1303. (defun tex-mma-math-pop-to-buffer ()
  1304.   (pop-to-buffer (process-buffer (get-process tex-mma-process-name))))
  1305.  
  1306. (defun tex-mma-math-get-output ()
  1307.   "Insert last output from Mathematica.
  1308. Assumes point in cell.  Output inserted at end of cell."
  1309.   (tex-mma-math-start-process)
  1310.   (let ((tex-mma-process (get-process tex-mma-process-name)))
  1311.     (let ((tex-mma-buffer (process-buffer tex-mma-process))
  1312.       (home-buffer (current-buffer))
  1313.       out-start out-end)
  1314.       (pop-to-buffer tex-mma-buffer)
  1315.       (goto-char math-last-input-end) ; First line of Mathematica output
  1316.       (beginning-of-line)     ; ..
  1317.       (forward-line 1)         ; ..
  1318.       (setq out-start (point))     ; ..
  1319.       (goto-char (point-max))     ; Last line
  1320.       (beginning-of-line)     ; .. exclude next In[..]:= prompt
  1321.       (setq out-end (point))
  1322.       (goto-char (point-max))     ; Leave point at next In[..]:= prompt
  1323.       (pop-to-buffer home-buffer)
  1324.                                  ; Insert output before \end{mathematica}
  1325.       (goto-char (tex-mma-cell-end "mathematica"))
  1326.       (forward-line 1)         ; Insert blank line before output
  1327.       (open-line 2)         ; ..
  1328.       (forward-line 1)         ; ..
  1329.       (insert-buffer-substring tex-mma-buffer out-start out-end)
  1330.       (beginning-of-line)     ; Delete blank lines at end of output
  1331.       (previous-line 1)         ; ..
  1332.       (kill-line 2)         ; ..
  1333.       )))
  1334.  
  1335. (defun tex-mma-math-start ()
  1336.   "Return position of start of text containing point.
  1337. Statement is delimited by blank lines (or start/end of buffer)."
  1338.   (save-excursion
  1339.     (beginning-of-line)
  1340.     (while (and
  1341.         (not (looking-at "\n"))
  1342.         (not (equal (point-min) (point))))
  1343.       (forward-line -1))
  1344.     (if (looking-at "\n")
  1345.     (forward-line 1)
  1346.       t)
  1347.     (point)))
  1348.  
  1349. (defun tex-mma-math-end ()
  1350.   "Return position of end of text containing point.
  1351. Statement is delimited by blank lines (or start/end of buffer)."
  1352.   (save-excursion
  1353.     (beginning-of-line)
  1354.     (while (and
  1355.         (not (looking-at "\n"))
  1356.         (not (equal (point-max) (point))))
  1357.       (forward-line 1))
  1358.     (if (looking-at "\n")
  1359.     (forward-line -1)
  1360.       (progn
  1361.     (forward-char -1)
  1362.     (if (looking-at "\n")
  1363.         t
  1364.       (forward-char 1))))
  1365.     (end-of-line)
  1366.     (point)))
  1367.  
  1368. ;; ;; tex-mma-mode
  1369.  
  1370. ;; This is a modified interface to tex-mode
  1371.  
  1372. (defvar TeX-mma-default-mode 'plain-TeX-mma-mode
  1373.   "*Mode to enter for a new file when it can't be determined whether
  1374. the file is plain TeX or LaTeX or what.")
  1375.  
  1376. (defvar TeX-mma-mode-syntax-table nil
  1377.   "Syntax table used while in TeX mode.")
  1378.  
  1379. (defvar TeX-mma-mode-map nil "Keymap for TeX-mma mode")
  1380.  
  1381. (if TeX-mma-mode-map 
  1382.     nil
  1383.   (setq TeX-mma-mode-map (make-sparse-keymap))
  1384.   (TeX-define-common-keys TeX-mma-mode-map)
  1385.   (define-key TeX-mma-mode-map "\"" 'TeX-insert-quote)
  1386.   (define-key TeX-mma-mode-map "\C-c\C-[" 'tex-mma-backward-cell)
  1387.   (define-key TeX-mma-mode-map "\C-c\C-]" 'tex-mma-forward-cell)
  1388.   (define-key TeX-mma-mode-map "\C-c\C-b" 'TeX-buffer)
  1389.   (define-key TeX-mma-mode-map "\C-c\C-e" 'tex-mma-math-find-error)
  1390.   (define-key TeX-mma-mode-map "\C-c\C-f" 'TeX-close-LaTeX-block)
  1391.   (define-key TeX-mma-mode-map "\C-c\C-r" 'TeX-region)
  1392.   (define-key TeX-mma-mode-map "\C-c\r" 'tex-mma-send)
  1393.   (define-key TeX-mma-mode-map "\C-c\t" 'tex-mma-toggle-init)
  1394.   (define-key TeX-mma-mode-map "\C-ca" 'tex-mma-eval-all-ask)
  1395.   (define-key TeX-mma-mode-map "\C-cc" 'tex-mma-create-cell)
  1396.   (define-key TeX-mma-mode-map "\C-ch" 'tex-mma-info)
  1397.   (define-key TeX-mma-mode-map "\C-ci" 'tex-mma-eval-init-ask)
  1398.   (define-key TeX-mma-mode-map "\C-cl" 'tex-mma-recenter)
  1399.   (define-key TeX-mma-mode-map "\C-cm" 'tex-mma-assemble-package)
  1400.   (define-key TeX-mma-mode-map "\C-cr" 'tex-mma-replace)
  1401.   (define-key TeX-mma-mode-map "\C-cs" 'tex-mma-show)
  1402.   (define-key TeX-mma-mode-map "\C-cu" 'tex-mma-update)
  1403.   (define-key TeX-mma-mode-map "\C-cv" 'tex-mma-version)
  1404.   (define-key TeX-mma-mode-map "\C-hE" 'math-extra-help)
  1405.   (define-key TeX-mma-mode-map "\C-he" 'math-help)
  1406.   (define-key TeX-mma-mode-map "\C-u\C-ca" 'tex-mma-eval-all-noask)
  1407.   (define-key TeX-mma-mode-map "\C-u\C-ci" 'tex-mma-eval-init-noask)
  1408.   (define-key TeX-mma-mode-map "\C-u\C-cm" 'tex-mma-assemble-cell)
  1409.   (define-key TeX-mma-mode-map "\e\r" 'tex-mma-send-cell)
  1410.   (define-key TeX-mma-mode-map "\e\t" 'tex-mma-do-completion)
  1411.   (define-key TeX-mma-mode-map "\eo" 'tex-mma-buffer-go)
  1412.   (define-key TeX-mma-mode-map "\e{" 'TeX-insert-braces)
  1413.   (define-key TeX-mma-mode-map "\e}" 'up-list)
  1414.   (define-key TeX-mma-mode-map "\n" 'TeX-terminate-paragraph)
  1415.   )
  1416.  
  1417. (fset 'TeX-mma-mode 'tex-mma-mode)
  1418. (fset 'plain-TeX-mma-mode 'plain-tex-mma-mode)
  1419. (fset 'LaTeX-mma-mode 'latex-mma-mode)
  1420.  
  1421. ;;; This would be a lot simpler if we just used a regexp search,
  1422. ;;; but then it would be too slow.
  1423. (defun tex-mma-mode ()
  1424.   "Major mode for editing TeX/Mathematica files of input for TeX or LaTeX.
  1425. Trys to intuit whether this file is for plain TeX or LaTeX and
  1426. calls plain-tex-mma-mode or latex-mma-mode.  If it cannot be determined
  1427. \(e.g., there are no commands in the file), the value of
  1428. TeX-mma-default-mode is used."
  1429.   (interactive)
  1430.   (let (mode slash comment)
  1431.     (save-excursion
  1432.       (goto-char (point-min))
  1433.       (while (and (setq slash (search-forward "\\" nil t))
  1434.           (setq comment (let ((search-end (point)))
  1435.                   (save-excursion
  1436.                     (beginning-of-line)
  1437.                     (search-forward "%" search-end t))))))
  1438.       (if (and slash (not comment))
  1439.       (setq mode (if (looking-at "documentstyle")
  1440.              'latex-mma-mode
  1441.                'plain-tex-mma-mode))))
  1442.     (if mode (funcall mode)
  1443.       (funcall TeX-mma-default-mode))))
  1444.  
  1445. (defun plain-tex-mma-mode ()
  1446.   "Major mode for editing TeX/Mathematica files of input for plain TeX.
  1447.  
  1448. Use \\[tex-mma-info] for help on TeX/Mathematica tools.
  1449.  
  1450. Makes $ and } display the characters they match.
  1451. Makes \" insert `` when it seems to be the beginning of a quotation,
  1452. and '' when it appears to be the end; it inserts \" only after a \\.
  1453.  
  1454. Use \\[TeX-region] to run TeX on the current region, plus a \"header\"
  1455. copied from the top of the file (containing macro definitions, etc.),
  1456. running TeX under a special subshell.  \\[TeX-buffer] does the whole buffer.
  1457. \\[TeX-print] prints the .dvi file made by either of these.
  1458.  
  1459. Use \\[validate-TeX-buffer] to check buffer for paragraphs containing
  1460. mismatched $'s or braces.
  1461.  
  1462. Special commands:
  1463. \\{TeX-mma-mode-map}
  1464.  
  1465. Mode variables:
  1466. TeX-directory
  1467.     Directory in which to create temporary files for TeX jobs
  1468.     run by \\[TeX-region] or \\[TeX-buffer].
  1469. TeX-dvi-print-command
  1470.     Command string used by \\[TeX-print] to print a .dvi file.
  1471. TeX-show-queue-command
  1472.     Command string used by \\[TeX-show-print-queue] to show the print
  1473.     queue that \\[TeX-print] put your job on.
  1474.  
  1475. Entering plain-TeX-mma mode calls the value of text-mode-hook,
  1476. then the value of TeX-mma-mode-hook, and then the value
  1477. of plain-TeX-mma-mode-hook."
  1478.   (interactive)
  1479.   (TeX-mma-common-initialization)
  1480.   (setq mode-name "TeX/Mathematica")
  1481.   (setq major-mode 'plain-tex-mma-mode)
  1482.   (setq TeX-command "tex")
  1483.   (setq TeX-start-of-header "%**start of header")
  1484.   (setq TeX-end-of-header "%**end of header")
  1485.   (setq TeX-trailer "\\bye\n")
  1486.   (run-hooks 'text-mode-hook 'TeX-mma-mode-hook 'plain-TeX-mma-mode-hook))
  1487.  
  1488. (defun latex-mma-mode ()
  1489.   "Major mode for editing LaTeX/Mathematica files of input for LaTeX.
  1490.  
  1491. Use \\[tex-mma-info] for help on TeX/Mathematica tools.
  1492.  
  1493. Makes $ and } display the characters they match.
  1494. Makes \" insert `` when it seems to be the beginning of a quotation,
  1495. and '' when it appears to be the end; it inserts \" only after a \\.
  1496.  
  1497. Use \\[TeX-region] to run LaTeX on the current region, plus the preamble
  1498. copied from the top of the file (containing \\documentstyle, etc.),
  1499. running LaTeX under a special subshell.  \\[TeX-buffer] does the whole buffer.
  1500. \\[TeX-print] prints the .dvi file made by either of these.
  1501.  
  1502. Use \\[validate-TeX-buffer] to check buffer for paragraphs containing
  1503. mismatched $'s or braces.
  1504.  
  1505. Special commands:
  1506. \\{TeX-mma-mode-map}
  1507.  
  1508. Mode variables:
  1509. TeX-directory
  1510.     Directory in which to create temporary files for TeX jobs
  1511.     run by \\[TeX-region] or \\[TeX-buffer].
  1512. TeX-dvi-print-command
  1513.     Command string used by \\[TeX-print] to print a .dvi file.
  1514. TeX-show-queue-command
  1515.     Command string used by \\[TeX-show-print-queue] to show the print
  1516.     queue that \\[TeX-print] put your job on.
  1517.  
  1518. Entering LaTeX-mma mode calls the value of text-mode-hook,
  1519. then the value of TeX-mma-mode-hook, and then the value
  1520. of LaTeX-mma-mode-hook."
  1521.   (interactive)
  1522.   (TeX-mma-common-initialization)
  1523.   (setq mode-name "LaTeX/Mathematica")
  1524.   (setq major-mode 'LaTeX-mma-mode)
  1525.   (setq TeX-command "latex")
  1526.   (setq TeX-start-of-header "\\documentstyle")
  1527.   (setq TeX-end-of-header "\\begin{document}")
  1528.   (setq TeX-trailer "\\end{document}\n")
  1529.   (run-hooks 'text-mode-hook 'TeX-mma-mode-hook 'LaTeX-mma-mode-hook))
  1530.  
  1531. (defun TeX-mma-common-initialization ()
  1532.   (kill-all-local-variables)
  1533.   (use-local-map TeX-mma-mode-map)
  1534.   (setq local-abbrev-table text-mode-abbrev-table)
  1535.   (if (null TeX-mma-mode-syntax-table)
  1536.       (progn
  1537.     (setq TeX-mma-mode-syntax-table (make-syntax-table))
  1538.     (set-syntax-table TeX-mma-mode-syntax-table)
  1539.     (modify-syntax-entry ?\\ ".")
  1540.     (modify-syntax-entry ?\f ">")
  1541.     (modify-syntax-entry ?\n ">")
  1542.     (modify-syntax-entry ?$ "$$")
  1543.     (modify-syntax-entry ?% "<")
  1544.     (modify-syntax-entry ?\" ".")
  1545.     (modify-syntax-entry ?& ".")
  1546.     (modify-syntax-entry ?_ ".")
  1547.     (modify-syntax-entry ?@ "_")
  1548.     (modify-syntax-entry ?~ " ")
  1549.     (modify-syntax-entry ?' "w"))
  1550.     (set-syntax-table TeX-mma-mode-syntax-table))
  1551.   (make-local-variable 'paragraph-start)
  1552.   (setq paragraph-start "^[ \t]*$\\|^[\f\\\\%]")
  1553.   (make-local-variable 'paragraph-separate)
  1554.   (setq paragraph-separate paragraph-start)
  1555.   (make-local-variable 'comment-start)
  1556.   (setq comment-start "%")
  1557.   (make-local-variable 'comment-start-skip)
  1558.   (setq comment-start-skip "\\(\\(^\\|[^\\]\\)\\(\\\\\\\\\\)*\\)\\(%+ *\\)")
  1559.   (make-local-variable 'comment-indent-hook)
  1560.   (setq comment-indent-hook 'TeX-comment-indent)
  1561.   (make-local-variable 'TeX-command)
  1562.   (make-local-variable 'TeX-start-of-header)
  1563.   (make-local-variable 'TeX-end-of-header)
  1564.   (make-local-variable 'TeX-trailer)
  1565. )
  1566.